home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ARCHIVES.SWG / 0009_Test String Compression.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  95 lines
  1. Program TestComp;  { tests Compression }
  2.  
  3. { kludgy test of Compress Unit }
  4.  
  5. Uses Crt, Dos, Compress;
  6.  
  7. Const
  8.   NumofStrings = 5;
  9.  
  10. Var
  11.   ch : Char;
  12.   LongestStringLength,i,j,len : Integer;
  13.   Textfname,Compfname : String;
  14.   TextFile : Text;
  15.   ByteFile : File;
  16.   CompArr : tCompressedStringArray;
  17.   st : Array[1..NumofStrings] of String;
  18.   Rec : SearchRec;
  19.   BigArr : Array[1..5000] of Byte;
  20.   Arr : Array[1..NumofStrings] of tCompressedStringArray;
  21.  
  22. begin
  23.   Writeln('note:  No I/O checking in this test.');
  24.   Write('Test <C>ompress or <U>nCompress? ');
  25.   Repeat
  26.     ch := upCase(ReadKey);
  27.   Until ch in ['C','U',#27];
  28.   if ch = #27 then halt;
  29.   Writeln(ch);
  30.   if ch = 'C' then begin
  31.     Writeln('Enter ',NumofStrings,' Strings:');
  32.     LongestStringLength := 0;
  33.     For i := 1 to NumofStrings do begin
  34.       Write(i,': ');
  35.       readln(st[i]);
  36.       if length(st[i]) > LongestStringLength then
  37.         LongestStringLength := length(st[i]);
  38.     end;
  39.     Writeln;
  40.     Writeln('Enter name of File to store unCompressed Strings in.');
  41.     Writeln('ANY EXISTinG File With THIS NAME WILL BE OVERWRITTEN.');
  42.     readln(Textfname);
  43.     assign(TextFile,Textfname);
  44.     reWrite(TextFile);
  45.     For i := 1 to NumofStrings do
  46.       Writeln(TextFile,st[i]);
  47.     close(TextFile);
  48.     Writeln;
  49.     Writeln('Enter name of File to store Compressed Strings in.');
  50.     Writeln('ANY EXISTinG File With THIS NAME WILL BE OVERWRITTEN.');
  51.     readln(Compfname);
  52.     assign(ByteFile,Compfname);
  53.     reWrite(ByteFile,1);
  54.     For i := 1 to NumofStrings do begin
  55.       CompressString(st[i],CompArr,len);
  56.       blockWrite(ByteFile,CompArr,len);
  57.     end;
  58.     close(ByteFile);
  59.     FindFirst(Textfname,AnyFile,Rec);
  60.     Writeln;
  61.     Writeln;
  62.     Writeln('Size of Text File storing Strings: ',Rec.Size);
  63.     Writeln;
  64.     Writeln('Using Typed Files, a File of Type String[',
  65.              LongestStringLength,
  66.              '] would be necessary.');
  67.     Writeln('That would be ',
  68.              (LongestStringLength+1)*NumofStrings,
  69.              ' long, including length Bytes.');
  70.     Writeln;
  71.     FindFirst(Compfname,AnyFile,Rec);
  72.     Writeln('Size of the Compressed File: ',Rec.Size);
  73.     Writeln;
  74.     Writeln('Now erase the Text File, and run this Program again, choosing');
  75.     Writeln('<U>nCompress to show that the Compression retains all info.');
  76.   end else begin                        { ch = 'U' }
  77.     Write('Name of Compressed File: ');
  78.     readln(Compfname);
  79.     assign(ByteFile,Compfname);
  80.     reset(ByteFile,1);
  81.     blockread(ByteFile,BigArr,Filesize(ByteFile));
  82.     close(ByteFile);
  83.     For j := 1 to NumofStrings do begin
  84.       i := 1;
  85.       While BigArr[i] <> 0 do inc(i);
  86.       move(BigArr[1],Arr[j],i);
  87.       move(BigArr[i+1],BigArr[1],sizeof(BigArr));
  88.     end;
  89.     For i := 1 to NumofStrings do
  90.       st[i] := GetCompressedString(Arr[i]);
  91.     For i := 1 to NumofStrings do
  92.       Writeln(st[i]);
  93.   end;
  94. end.
  95.